perm filename TEMPER.SAI[HAK,ROB]2 blob
sn#504393 filedate 1980-02-18 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00007 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "TEMPER"
C00004 00003 ! A caveat!
C00006 00004 ! Thrm routines
C00012 00005 ! Status fetching routines
C00017 00006 ! Scaling and formatting routines
C00020 00007 ! The top level last, like all good SAILors do when they're far away at sea
C00024 ENDMK
C⊗;
BEGIN "TEMPER"
REQUIRE "DDHDR.SAI[GRA,HPM]" SOURCE_FILE;
REQUIRE "LOITER.REL[HAK,ROB]" LOAD_MODULE;
REQUIRE "{}<>" DELIMITERS;
LET
⊂ = BEGIN, ⊃ = END, S⊂ = START_CODE, Q⊂ = QUICK_CODE;
DEFINE
!={COMMENT};
DEFINE
SP={" "}, CR={('15&"")}, LF={('12&"")}, ↓={(CR&LF)}, TAB={('11&"")},
FF={('14&"")}, ALT={('175&"")};
DEFINE
THRU={STEP 1 UNTIL};
DEFINE
D$PRINT(str) = {IFC D$UG THENC PRINT(str) ENDC},
D$UG ← {-1};
DEFINE PI = { 3.1415926536 };
DEFINE pos_int_infinity = { '377777777777 }; ! = 34359738367;
DEFINE neg_int_infinity = { '400000000000 }; ! = -34359738368;
DEFINE pos_real_infinity = { 1.70141182@38 }; ! just weird numbers that work;
DEFINE neg_real_infinity = { -1.69808878@38 };
DEFINE clear_screen = { CALL ((-1 LSH 18) + LOCATION ('004000000516), "TTYSET") };
DEFINE Quit = { BEGIN CALL(1,"EXIT"); END };
DEFINE ErrQuit(s) = { BEGIN PRINT(S); CALL(1,"EXIT"); END };
DEFINE DChan = {0}; ! Disk channel;
DEFINE xlo = 0, xhi = 100, ylo = 0, yhi = 100;
! A caveat!
SAIL doesn't know how to handle a procedure as a field of a record.
To get around this, we pass LOCATION(procedure) around as an integer,
and use the CalReal or CalString procedures to do the right thing.;
RECORD_CLASS thrm(
REAL Xorg, Yorg, Height;
INTEGER N_Steps;
STRING Title;
INTEGER Gratify);
REAL PROCEDURE CalReal(INTEGER fn; REAL x);
QUICK_CODE
PUSH '17,x ;
PUSHJ '17,@fn ;
END;
SIMPLE STRING PROCEDURE CalString(INTEGER fn; REAL x);
⊂ "CalStr"
STRING s;
START_CODE
PUSH '17,-1('17) ; ! Stuff x;
PUSHJ '17,@-3('17) ; ! Call fn(x);
MOVEI 1,s ; ! SAIL can't do addressing arithmetic;
POP '16,(1) ; ! S ← fn(x);
POP '16,-1(1) ;
END;
RETURN(s);
⊃ "CalStr";
! Thrm routines;
COMMENT
Here is a crufty picture of a prototypical TEMPERometer:
.-._____abs_top
| | ↓
| | top_clearance
| |___↑
| | ↓
| | thrm:Height ( = thrm_height)
| | ↑
| |___|
| | ↓
| | bot_clearance
/ \ ↑
| ._|__|_thrm:Yorg ( = abs_zero)
\_|_/
|
thrm:Xorg ( = x_centr)
(end of comment);
!--------------------;
DEFINE stem_rad={.7}, bubl_rad={1.25}, bot_clearance={4}, top_clearance={2};
DEFINE txt_wid={(6/512)*(xhi-xlo)}, txt_hig={(10/481)*(yhi-ylo)};
!--------------------;
PROCEDURE Draw_Therm(RECORD_POINTER(thrm)trp);
⊂ "Draw therm"
DEFINE x_centr={thrm:Xorg[trp]}, abs_zero={thrm:Yorg[trp]}, thrm_height={thrm:Height[trp]};
DEFINE
border = {4}, l_border={x_centr-border}, r_border={x_centr+border},
t_border={(abs_zero+bot_clearance+thrm_height+top_clearance+border)},
b_border={(abs_zero-border)};
!--------------------;
REAL LSide,RSide,Abs_Top; INTEGER I;
!--------------------;
LSide ← x_centr - stem_rad;
RSide ← x_centr + stem_rad;
Abs_Top ← abs_zero + bot_clearance + thrm_height + top_clearance;
LITEN;
LINE(LSide,abs_zero,LSide,Abs_Top);
LINE(RSide,abs_zero,RSide,Abs_Top);
LINE(LSide,Abs_Top,x_centr-(stem_rad/3),Abs_Top+stem_rad);
LINE(RSide,Abs_Top,x_centr+(stem_rad/3),Abs_Top+stem_rad);
LINE(x_centr-(stem_rad/3),Abs_Top+stem_rad,x_centr+(stem_rad/3),Abs_Top+stem_rad);
ELLIPS(x_centr-bubl_rad,abs_zero-bubl_rad,x_centr+bubl_rad,abs_zero+bubl_rad);
TXTPOS
(x_centr-(LENGTH(thrm:title[trp])/2),abs_zero-bubl_rad-txt_hig-1,
txt_wid,txt_hig);
TEXTD(thrm:Title[trp]);
IF thrm:N_Steps[trp] > 0 THEN
FOR I ← 0 THRU thrm:N_Steps[trp] DO
⊂ "Draw graticule"
!--------------------;
REAL Curr_Height, Curr_Temperature;
!--------------------;
Curr_Temperature ← I/thrm:N_Steps[trp];
Curr_Height ← (abs_zero + bot_clearance) + (thrm_height * Curr_Temperature);
LINE(RSide,Curr_Height,RSide+1,Curr_Height);
TXTPOS(RSide+1,Curr_Height,txt_wid,txt_hig);
TEXTD(CalString(thrm:Gratify[trp],Curr_Temperature));
⊃ "Draw graticule";
⊃ "Draw therm";
PROCEDURE Update_Temperature(
RECORD_POINTER(thrm) trp;
REAL temper);
⊂ "Update Temperature"
DEFINE
x_centr={thrm:Xorg[trp]}, abs_zero={thrm:Yorg[trp]}, thrm_height={thrm:Height[trp]};
DEFINE
epsilon={(100/512)};
!--------------------;
REAL LSide,RSide,Abs_Top; INTEGER I;
!--------------------;
LSide ← x_centr - stem_rad;
RSide ← x_centr + stem_rad;
Abs_Top ← abs_zero + bot_clearance + thrm_height + top_clearance;
DRKEN;
RECTAN(LSide+epsilon,abs_zero,RSide-epsilon,abs_top);
LITEN;
RECTAN(
LSide+epsilon,abs_zero,
RSide-epsilon,(abs_zero+bot_clearance)+(thrm_height*temper));
⊃ "Update Temperature";
RECORD_POINTER(thrm) PROCEDURE New_Therm(
REAL Xorg, Yorg, Height;
INTEGER N_Steps;
STRING Title;
STRING PROCEDURE Gratz);
⊂ "New_Therm"
!--------------------;
RECORD_POINTER(thrm) trp;
!--------------------;
trp ← NEW_RECORD(thrm);
thrm:Xorg[trp] ← Xorg;
thrm:Yorg[trp] ← Yorg;
thrm:Height[trp] ← Height;
thrm:N_Steps[trp] ← N_Steps;
thrm:Title[trp] ← Title;
thrm:Gratify[trp] ← LOCATION(Gratz);
RETURN(trp);
⊃ "New_Therm";
! Status fetching routines;
! cf also THERMO[T,ACT], ACCT[ACT,SYS] - ME wants to store DSKF;
INTEGER PROCEDURE GetDMS;
⊂ "GetDMs"
! Look through DCATAB, for DCACAR bit (both gleaned from LCOR),
start at DCATAB+'20 for .SYML("NPORDM") (number of DMs);
DEFINE DSYML(ac) = {CALLI ac,'400010};
DEFINE DCATAB = {'400342}; ! DCACAR,,DCATAB;
DEFINE NPORDM = {'022643135507}; ! RADIX50 0,NPORDM;
LABEL DMsBlk;
START_CODE
hlrz 1,dcatab ; ! fetch carrier mask;
hrrz 2,dcatab ; ! fetch address of DCATAB;
movei 3,DMsBlk ;
calli 3,'400010 ; ! That is a .SYML 3,;
DMsBlk: NPORDM ; ! Number of DM ports;
0
END;
⊃ "GetDMs";
REAL PROCEDURE GetLAV;
⊂ "GetLAV"
DEFINE loadav = {'400331};
INTEGER ldavg,ldshf,ldpwr;
START_CODE
hlrz 1,loadav ;
movem 1,ldshf ; ! actually contains (LDSHF*1000)+LDPWR;
hrrz 1,loadav ;
move 1,'400000(1) ; ! fetch the current ldavg;
movem 1,ldavg ;
END;
ldpwr ← (ldshf DIV '1000) + (ldshf MOD '1000);
RETURN(ldavg/(2↑ldpwr));
⊃ "GetLAV";
INTEGER PROCEDURE GetNJB;
⊂ "GetNJB"
DEFINE prjprg = {'400211}; ! lookin in JBTSTS, either JNA ∨ CMWB means ∃ job;
START_CODE
LABEL L1;
MOVEI 1,0 ; ! Number of jobs starts at 0;
MOVE 2,PRJPRG ; ! Right half as pointer;
HRLI 2,-64 ; ! left half as counter;
L1: SKIPE '400000(2); ! Test entry in table, and increment;
AOS 1 ; ! count if non-null;
AOBJN 2,L1 ; ! and loop;
END;
⊃ "GetNJB";
INTEGER PROCEDURE GetDDC;
⊂ "GetDDC"
DEFINE ddfcnt = {'400312}, ddqsiz = {'400332};
START_CODE
MOVE 2,ddfcnt ;
MOVN 1,'400000(2);
ADDI 1,31 ; ! Yes, 31 decimal;
MOVE 2,ddqsiz ;
ADD 1,'400000(2);
END;
⊃ "GetDDC";
INTEGER PROCEDURE GetFDB;
START_CODE "GetFDB"
LABEL FDBlck, FDB1 ;
MTAPE DChan,FDBlck ;
JRST FDB1 ;
FDBlck: '475744555744 ; ! SIXBIT/GODMOD/;
'22 ; ! Get free block count;
'1 ; ! Register 1 gets the result;
FDB1:
END "GetFDB";
INTEGER PROCEDURE GetIHOT;
START_CODE "GetIHOT"
LABEL IHBlck,IHB1 ;
MOVEI 1,IHBlck ;
CALLI 1,'400010 ; ! That is a .SYML 1,;
JRST 4, ;
MOVE 1,'400000(1) ;
JRST IHB1 ;
IHBlck: '017047253067 ;
'0 ;
IHB1:
END "GetIHOT";
INTEGER PROCEDURE GetOHOT;
START_CODE "GetOHOT"
LABEL OHBlck,OHB1 ;
MOVEI 1,OHBlck ;
CALLI 1,'400010 ; ! That is a .SYML 1,;
JRST 4, ;
MOVE 1,'400000(1) ;
JRST OHB1 ;
OHBlck: '023517053067 ; ! "OTHERM" in radix50;
0 ;
OHB1:
END "GetOHOT";
PROCEDURE SetMap;
! Maps the job tables as an upper segment (starting at 400000)
Gotta call this routine before trying to do any of the above
routines.;
START_CODE
PUSH '17,1 ;
MOVSI 1,'377777 ;
CALLI 1,'400052 ; ! SETPR2;
JRST 4, ; ! error return - help! ;
POP '17,1 ;
END;
! Scaling and formatting routines;
STRING PROCEDURE DDCText(REAL x);
⊂ "DDCText" SETFORMAT(0,0); RETURN(CVS(36 * x)); ⊃ "DDCText";
REAL PROCEDURE DDCScale(INTEGER DDC);
RETURN(DDC / 36);
STRING PROCEDURE LAVText(REAL x);
⊂ "LdavText" SETFORMAT(0,0); RETURN(CVS(14 * x)); ⊃ "LdavText";
REAL PROCEDURE LAVScale(REAL LAV);
RETURN(LAV / 14);
DEFINE alpha = {(1.5)}, beta = {(5000.)};
STRING PROCEDURE FDBText(REAL x);
⊂ "FDBText" SETFORMAT(0,0); RETURN(CVS( (beta*(1-x))/(alpha-(1-x)))); ⊃ "FDBText";
REAL PROCEDURE FDBScale(REAL FDB);
RETURN(1-((alpha*FDB)/(FDB + beta)));
STRING PROCEDURE NJBText(REAL x);
⊂ "NJBText" SETFORMAT(0,0); RETURN(CVS(63 * x)); ⊃ "NJBText";
REAL PROCEDURE NJBScale(REAL NJB);
RETURN(NJB / 63);
STRING PROCEDURE IHOTText(REAL x);
⊂ "IHOTText" SETFORMAT(0,0); RETURN(CVS(100 * x)); ⊃ "IHOTText";
REAL PROCEDURE IHOTScale(REAL IHOT);
RETURN(IHOT / 100);
STRING PROCEDURE OHOTText(REAL x);
⊂ "OHOTText" SETFORMAT(0,0); RETURN(CVS(100 * x)); ⊃ "OHOTText";
REAL PROCEDURE OHOTScale(REAL OHOT);
RETURN(OHOT / 100);
! The top level last, like all good SAILors do when they're far away at sea;
DEFINE DelayTime = {(10.0)}, ChrTyped = {(-1)};
INTERNAL PROCEDURE MESLEN;! simply to fool LOITER;;
EXTERNAL INTEGER !SKIP!;
! From LOITER.REL[SIX,MUS];
EXTERNAL INTEGER PROCEDURE Loiter(REAL Seconds; BOOLEAN NoTTY(FALSE));
INTEGER DDChan, QuitChr;
RECORD_POINTER(thrm) DDCThr,LAVThr,FDBThr,NJBThr,ITherm,OTherm;
SetMap; ! Map system tables as upper segment;
OPEN(DChan,"DSK",0,0,0,0,0,0);! Open disk for doing MTAPEs;
! Set up our TEMPERometers;
DDCThr ← New_Therm(10,10,70,6,"DD Chns",DDCText);
LAVThr ← New_Therm(20,10,70,7,"LoadAve",LAVText);
FDBThr ← New_Therm(30,10,70,8,"DskBlks",FDBText);
NJBThr ← New_Therm(40,10,70,9,"# Jobs",NJBText);
ITherm ← New_Therm(80,10,70,10,"I Temp",IHOTText);
OTherm ← New_Therm(90,10,70,10,"O Temp",OHOTText);
! Draw the TEMPERometers;
DO
⊂ "Main Loop"
DDChan ← IF GetDDC<30 THEN GDDCHN(-1) ELSE -1; ! Fetch us a channel;
DDINIT; ! initialize the DD buffer;
SCREEN (xlo,ylo,xhi,yhi); ! Define the screen dimensions;
ERASE(DDChan); ! Erase our channel-to-be;
Draw_Therm(DDCThr);
Draw_Therm(LAVThr);
Draw_Therm(FDBThr);
Draw_Therm(NJBThr);
Draw_Therm(ITherm);
Draw_Therm(OTherm);
SHOW(DDChan);
DO
⊂ "Inner Loop"
Update_Temperature(DDCThr,DDCScale(GetDDC));
Update_Temperature(LAVThr,LAVScale(GetLAV));
Update_Temperature(FDBThr,FDBScale(GetFDB));
Update_Temperature(NJBThr,NJBScale(GetNJB));
Update_Temperature(ITherm,IHOTScale(GetIHot));
Update_Temperature(OTherm,OHOTScale(GetOHot));
DPYUP (DDChan);
⊃ "Inner Loop"
UNTIL LOITER(DelayTime) = ChrTyped;
RDDCHN(DDChan); ! Release DD channel;
SHOW(-1); ! And give us back our channel;
QuitChr ← INCHWL;
IF !SKIP! = ALT THEN
⊂ "refresh"
DPYUP(DDChan);
⊃ "refresh";
⊃ "Main Loop"
UNTIL !SKIP! ≠ ALT;
clear_screen;
IF QuitChr = "x" OR QuitChr = "X"
THEN IF GetNJB < 63
THEN ⊂ PRINT("Queuing XGP request",↓); XGPQUE(2) ⊃
ELSE ⊂ PRINT("No job slots, will output to XGP",↓); XGPUP(2) ⊃;
ErrQuit(<"ciao."&↓>);
END "TEMPER";